home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.09 Sep 88 / Dubin Article / TurboPascal Version / ACountPix.asm next >
Encoding:
Assembly Source File  |  1987-08-29  |  4.2 KB  |  140 lines  |  [TEXT/EDIT]
  1. ;
  2. ;    ACountPix.asm
  3. ;    Pascal Usage: Function ACountPix( theRegion:RgnHandle) : LongInt;
  4. ;    This functiion emulates CountPix
  5. ;     Written by Thomas W. Moore, Ph.D. and Stephen Dubin, V.M.D., Ph.D.
  6. ;    Copyright © 1987
  7.         
  8.         XDEF  ACountPix
  9.         XREF  myBUF
  10. ;--------------------------------- INCLUDES -------------------------------
  11.  
  12. Include     Traps.D            ; Use System and ToolBox traps
  13. Include     ToolEqu.D            ; Use ToolBox equates
  14.  
  15.  
  16.  
  17. ACountPix:
  18.     link        A6,#0            ; set up frame pointer
  19.     movem.l    A0-A3/D0-D7,-(A7)    ; save the world
  20.     clr.l        -(A7)            ; make room on stack for result
  21.     movea.l    8(A6),A0        ; region handle into A0
  22.     movea.l    (A0),A0        ; dereference => pointer in A0
  23.     clr.l        D7            ; set area to zero
  24.     lea        myBUF(A5),A1    ; lowest address of x list
  25.         
  26. rectcheck:            ; see whether it is a rect and if so - do  the job here
  27.      cmpi.w    #10,(A0)        ; is this a single rectangle
  28.      bne.s        morework        ; if not do the big job
  29.      move.w    4(A0),D1        ; left
  30.      move.w    8(A0),D2        ; right
  31.      move.w    2(A0),D3        ; top
  32.      move.w    6(A0),D4        ; bottom
  33.      sub.w        D1,D2            ; width
  34.      sub.w        D3,D4            ; height
  35.      mulu.w    D2,D4            ; area in D4
  36.      move.w    D4,D7            ; lower word into D7
  37.      bra        done
  38.  
  39. morework:            ; get ready for some serious work
  40.     lea        10(A0),A0        ; beginning of region info
  41.     clr.l        D4            ;
  42.     clr.l        D2            ;
  43.     move.l    #512,D3        ; size of buffer to hold ordered list of x values
  44.     adda.l    D3,A1            ; highest address in buffer
  45.     movea.l    A1,A2            ; copy in A2
  46.     movea.l    A1,A3            ; another in A3
  47.     move.w    #-1,(A1)        ; -1 in highest x address so that 1st x entry will be greater
  48.  
  49. gety:                ; read in y coordinate of next horizontal boundary                             ; 
  50.     move.w    (A0)+, D3        ; latest y value
  51.     jsr        calc            ; 
  52.     
  53. getx:
  54.     move.w    (A0)+,D1        ; new x value
  55.     cmpi.w    #$7fff,D1        ; flag indicates no more x values at this y
  56.     bne        storex        ; if no flag, it is a new x
  57.     move.w    (A0),D1        ; next word of region info
  58.     cmpi.w    #$7fff,D1        ; all done?
  59.     beq        done            ; yes go home
  60.     bra        gety            ; no, get next y
  61.  
  62. storex:            ; place new x value in proper place in ordered list
  63.     movea.l    A3,A1            ; A3 points to highest x value in ordered list
  64.     cmp.w        (A1),D1        ; compare new x value to largest entry
  65.     bne        s1            ; if not equal, it must be added to list
  66.     addq        #2,A3            ; if match, remove from list
  67.     bra        getx            ; next x
  68.     
  69. s1:
  70.     lea        -2(A3),A3        ; add a space at high end of list for new x
  71.     bgt.s        insert        ; if new x value is greatest, put it on top
  72.     
  73. mkroom:            ; new x is not greatest so we must move list values up to make room
  74.     move.w    (A1)+,-4(A1)    ; move data  up (1 word net distance)
  75.     cmp.w        (A1),D1        ; compare next list entry
  76.     beq.s        remove        ; if it matches, remove it
  77.     bcc.s        insert        ; it is greater, so put it above
  78.     cmpa.l    A1,A2            ; are we at bottom?
  79.     bne        mkroom        ; no, move another one up
  80.     
  81. insert:            ; insert new x value in ordered place in list
  82.     move.w    D1,-(A1)        ; insert above present location
  83.     bra        getx            ;
  84.     
  85. remove:            ; erases an entry from the list
  86.     subq        #2,A1            ; point to next higher
  87.     
  88. r1:
  89.     cmpa.l    A1,A3            ; is it the top?
  90.     beq        shrink        ; yes so exit
  91.     move.w    -(A1),4(A1)        ; move greater x values down to replace
  92.     bra        r1            ; value removed
  93.     
  94. shrink:
  95.     addq        #4,A3            ; if a match occurred, list shrinks by 2 words
  96.     bra        getx            ; one that we didn't insert and one that we erased
  97.     
  98. calc:                ; determine new Height
  99.     sub.w         D3,D4            ; Y old - Y new
  100.     neg.w        D4            ; Height of the rectangle(s)
  101.     
  102. newW:                ; prepare for Width calculation
  103.     clr.l        D2            ; Will receive width
  104.     clr.l        D1            ; work reg
  105.     movea.l    A2,A1            ; reset A1 to point to least x value in list
  106.     
  107. dx:                ; check to see if all x pairs have been used. 
  108.                 ; multiply H x W and add to area
  109.     cmpa.l    A1,A3            ; A3 points to greatest x value in list
  110.     bne        morex            ; if not equal, not all x's have been used
  111.     mulu          D4,D2            ; H x W
  112.     add.l        D2,D7            ; add to accumulating area
  113.     move.w    D3,D4            ; for next time
  114.     rts
  115.     
  116. morex:            ; subtracts x values in pairs adding differences 
  117.                 ; to accumulating W
  118.     move.w    -(A1),D1        ; Xi (lower x value of a pair)
  119.     sub.w        -(A1),D1        ; Xi - Xi+1 (length of a horizontal boundary segment)
  120.     neg.w        D1            ; Xi+1 - Xi (correct sign)
  121.     add.w        D1,D2            ; W (add to accumulating width)
  122.     bra        dx            ;
  123.         
  124. done:
  125.     move.l    D7,12(A6)        ; store result "under" the last parameter
  126.     movem.l    (A7)+,A0-A3/D0-D7    ; restore registers
  127.     unlk        A6            ; restore original stack
  128.     move.l    (A7)+,A0        ; get return address
  129.     addq.l    #4,A7            ; remove parameters
  130.     jmp        (A0)            ; return this way
  131.     
  132.     end
  133.  
  134.     
  135.  
  136.     
  137.     
  138.     
  139.     
  140.